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Connectivity between the various Perl files 

(1) ci.pl 
project . pi 

host . pi 
getsessionid.pl 
project .pi 
webdate - pi 

-> acceptdecline.pl (by way of form submission) 

acceptdecline . pi 
cgi.pl 

getsessionid.pl 
project . pi ... 
-> (2a) declined.html OR 
-> (2b) ci.pl 

(3) save.pl 

get session id. pi 

(4) calculate.pl 
project .pi ... 
getsessionid.pl ... 

-> (4a) overuse.html OR 

-> (4b) getresults.pl (by way of MET A refresh) 

(5) getresults.pl 
getsessionid.pl ... 
calculate2 .pi 

project .pi ... 
getsessionid.pl ... 
readstuf f . pi 

project .pi ( ? ! ) 

getsessionid.pl ( ? ! ) 
ansoft_files.pl 
remoteTLINE.pl 

getheadpost . pi 



MD5 checksums 

C4616dce32 06bfbaleld26e910fcdal9 
f62 7deb66f f 956 12e34bbc2 840b44069 
2f73d693dl3e2de292c2a9al7b09bb40 
d4d66bd7 8c7e3d2 44a844dc8c6568d83 
4f Oef 466c56dbf48f 431045b3c6b65af 
a2 3e9 322 9c5cd96f44ed6bfa8cb4 3923 
3dd2bd09c6af 82 lac94894 7 leO 140b51 
5f6136da8fbc2 67052ed9a6elfcd86c4 
7889f 9cab3787db2b0a4231ecl2 8a331 
a926a04944ceeeecaf 8c5ba09675aa46 
c04024bba7 8bf 2e5dalfc94 4f 3c083e2 
ccf 4d0e4 4f 6b7b5fa920e23ae02 2d4 6b 
f 62c02714876d4 686dell39739abccdf 
d3 0alca97 3 le7 f eccf 5922c 1681 192dc 
C2898185d4 0e61d3e8f 98add70d26f 4a 
2daeb6d25d7d4ffe52ed835721512f56 
cf20dclf 37dclcl012fdf7fccb8117dl 



readme 
all_md5 

acceptdecline . pi 
calculate . pi 
calculate2 .pi 
cgi .pi 
ci . pi 

getresults .pi 
getsessionid . pi 
host.pl 
makeauth .pi 
project . pi 
save .pi 
webdate . pi 

native_CrossSection . html 

nav3_CrossSection . html 

. . / . . /html/ Stackup/declined.html 
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19 90d33ac8912a6b25c3332b34decl4e71 . ./. . /html/ Stackup/error .html 

20 cdl410f 9391b66a64abe3f 0368f 72e66 . ./. . /html/ Stackup/overuse . html 

acceptdecline . pi 

1 #! /usr/bin/perl 

2 use strict; 

3 my $debug; 

4 #$debug = 1; 

5 if ($debug) { print "Content-Type: text/ html\n\n<HTML><BODY><PRE> " ; } 

6 require( "cgi .pi" ) ; 

7 # GLOBALS 

8 use vars qw( $debug ); 

9 require ( "getsessionid.pl" ) ; 

10 use vars qw ( $suid $user_id $usage $path_info $save_copy $cookie) ; 

11 my lvalues = &process_f orm( ) ; 

l 12 my $time = hex( &obscure( substr ( $values{ " token" } , 0 , 8 ) , 

13 substr ($values{" token" }, 8, 8) ) ); 

14 my $delay = $time+15-time ( ) ; 

15 if ($debug) { print "time: $time delay: $delay\n"; } 



16 require( "project.pl" ) ; 

17 use vars qw ( $H0ST_IP ) ; 



Hj 18 use vars qw($PROJECT $USAGE_MAX $ U SAG E_ INTERVAL $RECORD_LENGTH 

E; $NUM_RECORDS) ; 

S 19 if ($values{"choice"} =- /ACCEPT/) { 

Q 20 # if ($delay > 0) { sleep ( $delay ) ; } 

■fj 21 print "Location: http : //$HOST_IP/cgi-bin/$PROJECT/ci . pl\n" ; 

U 22 print "Pragma: no-cache\nExpires : Mon, 01 Jul 1996 00:00:00 GMT\n"; 

M= 23 if ($delay > -300) { print $cookie; } 

24 print "\n"; 

25 } 

26 else { 

27 print "Location: http: //$HOST_IP/$PROJECT/declined.html\n" ; 

28 print "Pragma: no-cache\nExpires : Mon f 01 Jul 1996 00:00:00 GMT\n"; 

29 print "\n" ; 

30 } 

calculate.pl 

1 #» /usr/bin/perl 

2 # calculate.pl 

3 # Copyright (C) 1999-2000 Rode Consulting, Inc. 

4 # All rights reserved. 

5 use strict; 

6 # GLOBALS 

7 use vars qw( $debug ); 

8 #$debug = 1; 
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9 require( "project.pl" ) ; 

10 use vars qw( $H0ST_IP ) ; 

11 use vars qw($PROJECT $USAGE_MAX $USAGE_INTERVAL $RECORD_LENGTH 
$NUM_RECORDS ) ; 

12 require( "getsessionid.pl" ) ; 

13 use vars qw ( $suid $new_suid $user_id $timestamp $usage $valid 
$path_info $cookie); 

14 $USAGE_MAX=10; 

15 if (?usage >= $USAGE_MAX) { 

16 print "Location: http : //$HOST__IP/$PROJECT/overuse . html\n" ; 

17 print "\n"; 

18 exit(O); 

19 } 

20 #print "Location: http : // " , $H0ST_IP, " /cgi-bin/$PR0JECT/calculate2 . pl\n " ; 

21 #print "\n"; 

22 # 

q 23 # Rather than directly forward to the script that does the real 
.'^calculation 

24 # We instead return a small HTML page that displays a message, before 

"M 25 # forwarding to the final location - 

III 

jjj 26 my $hash = &hash ( $user_id ) ; 

u . 

27 # Write new cookie to cookie cache 

Ijl 2 8 sysopen(AUDIT_DB, "auth.dat", 2) or die ("Can't open authorization 
Sldatabase! " ) ; 

2 9 sysseek( AUDIT_DB, $ hash* $RECORD_LENGTH , 0 ); 

E L. 30 my $written = syswrite( AUDIT_DB, ( $new_suid. " \n" ) , 
U 31 $RECORD_LENGTH ); 

q 32 die "System write error: $!\n" unless defined $written; 

^ 33 close (AUDIT_DB ) ; 



I 34 print "Pragma: no-cache\nExpires : Mon, Ol-Jul-1996 00:00:00 GMT\n"; 

35 print $cookie; 

36 print "Content-Type: text/html\n\n" ; 

37 print «"EOF" 

38 <HTML><HEAD><TITLE>Ex tract ion in progress ... </TITLE> 

39 <META HTTP-EQUIV="refresh" CONTENT= " 0 ; URL=http : / / $HOST_IP/ cgi- 
bin/$PROJECT/getresults .pl"> 

40 <SCRIPT LANGUAGE=" JavaScript ">< ! — 

41 badbrowser = (( navigator . appName == "Microsoft Internet Explorer") 
&& (parselnt (navigator. appVersion) ==4) && ( navigator . appVersion . indexOf ( "Mac " ) > 

0)); . 

42 if (badbrowser) this . focus () ; 

43 if ('badbrowser && window . focus ) this . focus () ; 

44 //— ></SCRIPT> 

45 </HEAD> 

46 <B0DY BGCOLOR="#FFFFFF" TEXT="#000000 " LINK="#0000FF " VLINK= "#AA0 0AA" 
ALINK="#FF0000"> 
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47 <TABLE VALIGN=CENTER WIDTH=" 100% " HEIGHT= "100% "XTRXTD VALIGN=CENTER 
ALIGN=CENTER> 

48 <CENTER><H2>Please wait . . . <BR>Extraction in progress</H2></CENTER> 
4 9 < / TD>< / TR>< / TABLE> 

50 </BODY> 

51 </HTML> 

52 EOF 
53 

54 1; 

calculate2 . pi 

1 #! /usr/bin/perl 

2 # calculate2.pl 

3 # Copyright (C) 1998-2000 Rode Consulting, Inc. (RCI) 

4 # All rights reserved. 

5 use strict; 

6 # GLOBAL S 

7 use vars qw( $debug ); 
O 8 #$debug = 1; 

>«j 9 if ($debug) { 

* 10 print "Content-Type: text/html\n" ; 

11 print "Pragma: no-cache\nExpires : Mon, 01 Jul 1996 00:00:00 GMT\n"; 

ffs 12 print "\n"; 

13 

IJI 



14 print "<BODYXPRE>\n" ; 

15 } 



16 require ( "project.pl" ) ; 

17 use vars qw( $HOST_IP ) ; 



9i 

o 

H 18 #use vars qw( $DOMAIN_NAME $HOST_NAME $HOST_IP $HOST_PREFIX 

Q$HOST_CGI_PREFIX) ; 

m 19 #use vars qw( $HOST_PREFIX_JAVA $HOST_CGI_PREFIX_JAVA) ; 

~ 20 #use vars qw($BODY $NOCACHE_HEADER $GS $JP2GIF $ ALCHEMY ) ; 

yf 21 #use vars qw( %HTML_MACROS ) ; 

a ■ 

22 use vars qw($PROJECT $USAGE_MAX $ US AG E_ INTERVAL ) ; 

2 3 require ( "getsessionid.pl" ) ; 

24 use vars qw ( $suid $user_id $timestamp $usage $valid $path_info 
$cookie) ; 

25 use vars qw( litems $user_id $root $dont_do_it $results); 

26 use vars qw( $units_name $units $scale ); 

27 my $LOCK_SH=l; my $LOCK_EX=2 ; my $LOCK_NB=4; my $L0CK_UN=8; 

28 if ( !$dont__do_it && ($usage > $USAGE_MAX) ) { 

29 print "Location: http: //$H0ST_IP/$PR0JECT7 overuse . html\n n ; 

30 print "\n"; 

31 exit(0); 

32 } 

33 if ( !$dont_do_it && ( ( time ( )-$timestamp) > 15)) { 

34 print "Location: http: //$HOST_IP/$PROJECT/error . html\n" ; 
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iii 



35 print M \n"; 

36 exit(O); 

37 } 

38 # Retrieve the binary data from a file 

39 if ( $dont_do_it | | 

40 ($valid>0 && -e " tmp/stuf f " . $user_id . sprintf ( "%04d M , $usage ) ) ) { 

41 # require (" readstuff.pl " ) ; 

42 # $root = "x.pjt"; 

43 # require ( "field_extractor_files.pl" ) ; 

44 # Early return for use with ez2dzip.pl 

45 # if ($dont_do_it) { return 1; } 

46 # open (LOCKFILE , "»tmp/lockf ile" ) ; 

47 # flock (LOCKFILE, $L0CK_EX); 

48 # seek (LOCKFILE, 0, 2); 

49 # require ( "remoteTLINE.pl" ) ; 

50 # flock (LOCKFILE, $LOCK_UN); 

51 # close ( LOCKFILE ) ; 

52 open (SAVE, ">tmp/results $user_id . sprintf ( "%04d" ,$usage) ) ; 

53 print SAVE "DUMMY"; 

54 close SAVE; 

55 } 

56 else { 

57 print "Location: http: //$HOST_IP/$PROJECT/error . html\n\n" ; 

58 exit 0; 

59 } 

60 1: 



n cgi.pl 

W 1 #! /usr/local/bin/perl 

j» 2 #Copyright (C) 1996-8 Rode Consulting, Inc. All rights reserved. 



3 #package myCGI ; 



□ 

Q 4 use strict; 



5 # GLOBALS: 

6 # $cgi_query: The query string (source depends on 
REQUEST_METHOD) 

7 # (logged by other scripts) 

8 # TEMP %form_values is global for compatibility 

9 # Special (evil?) mode flags: 

10 # $debug: Global cross-module debug flag 

11 # $ cgi lowercase: Form value names are all lowercased 

12 use vars qw($debug $_cgi_lowercase $cgi_query %f orm_values ) ; 

13 if ($debug) { print "cgi.pl called\n"; } 

14 # process_f orm( ) 

15 sub process_form { 

16 my ($ valid, Cpairs) = ( " " ,("")) ; 
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17 $| = 1; 

18 if ($debug) { print "Method: *' , $ENV{ 'REQUEST_METHOD ' } , "<BR>\n" ; 
} 

19 $valid = 

20 if ( $ENV { ' REQUEST_METHOD ' } eq 'GET') 

21 { 

22 $cgi_query = $ENV{ ' QUERY_STRING ' } ; 

23 $ valid = ( $ENV{ ' QUERY_STRING ' } ) ? "true" : " " ; 

24 } 

25 elsif ( $ENV{ ' REQUEST_METHOD ' } eq 'POST') 

26 { 

27 $ valid = ( $ENV{ ' CONTENT_LENGTH ' } > 0) ? "true" : 

28 if ($valid) { read(STDIN, $cgi_query, $ENV{ ' CONTENT_LENGTH ' } ) ; } 

29 $cgi_query =~ s/\n/\&/g; 

30 } 

31 elsif ($debug) { print "Unrecognized method: 
$ENV{ ' REQUEST_METHOD ' }\n" ; } 

32 if ($debug) { print "CGI arguments: ", $cgi_query, M <BR>\n"; 
1 } 

33 if ($valid) 

34 { 

35 @pairs = split(/&/, $cgi_query); 

36 foreach my $pair (@pairs) 

37 { 

38 $pair =~ s/\+\+/\+/g; 
M 39 $pair =~ s/\+/ /g; 

40 my ($name, $value) = split(/=/, $pair); 

41 $name =- s/ % ( [ a-f A-FO-9 ] { 2 } ) /pack ( ' c ' , hex ( $ 1 ) ) /eg ; 
!^ 42 $value =- s/% ([ a-f A-FO-9 ]{ 2 }) /pack (' c ', hex ($ 1 )) /eg ; 
O 43 $value =- s/%2 [ Ff ] A / /g ; 

M> 44 if ( $_cgi_lowercase ) { $name =- tr/A-Z/a-z/; } 

45 if ($form_values{$name} ) 

46 { $form_values{$name} .= "&" . $value; } 

sa 47 else 

□48 { $form_values{$name} = $value; } 



U s 



m 



49 if ($debug) { print $name, " = '", $ f orm_values{$name} , 

'"\n"; } 

50 } 

51 } 

52 %f orm_values ; 

53 } 

54 # get_cookie( -cookiename- ) 

55 # Returns the first cookie by the given name 

56 sub get_cookie { 

57 my ($cookie) = 

58 my (^cookies, $cookieName, $cookieVal) = ( ( " " ) , " " , " " ) ; 

59 if ($debug) { print M HTTP_COOKIE: " , $ENV{ "HTTP_COOKIE " } , " \n " ; } 

60 if ($ENV{"HTTP_COOKIE"} =- /$cookie/) 

61 { 

62 ^cookies = split (/; \s* /, $ENV{ "HTTP_COOKIE" }) ; 
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63 if ($debug) { print '@cookies: ' , @cookies , " \n" ; } 

64 

65 foreach (^cookies) 

66 { 

67 if ($_ =- /$cookie/) 

68 { 

69 ($cookieName, $cookieVal ) = split (/=/,$_); 
7 o return ( $cookieVal ) ; 

71 } 

72 } 

73 } 

74 else { return( " ); } 

75 } 

76 ##@LOOKUP = split ( /Name: /, 'nslookup $ENV{ "REMOTE_ADDR" } ' ) ; 

77 ##@LOOKUP = split (/Address:/, $L00KUP[1]); 

78 ##$client_name = $LOOKUP[0]; 

79 #$client_name = $ENV{ ft REMOTE_ADDR" } ; 

80 #$client_name =- s/ //g; 

81 #package form; 

D 82 1; 

k p ci . pi 

%s 1 #! /usr/bin/perl 

m 

jjfj 2 use strxct; 

I s * 3 # GLOBALS 

IH 4 use vars qw( $debug ) ; 

SI 

5 my $debug; 

!L 6 #$debug = 1; 

Q 7 if ($debug) { print "Content-Type: text/ html\n\n<HTML><BODY><PRE> " ; } 

f% 8 require ( "project .pi" ) ; 

!^ 9 use vars qw( $DOMAIN_NAME $HOST_NAME $HOST_IP $HOST_PREFIX 

$HOST CGI PREFIX); 

y. 10 use vars qw($PROJECT $USAGE_MAX $USAGE_INTERVAL $ RECORD_LENGTH 

$NUM_RECORDS) ; 

11 require ( "getsessionid.pl" ) ; 

12 use vars qw ( $suid $user_id Susage $path_info $save_copy $cookie); 

13 if ($debug) { 

14 print $suid," " , $user_id, " "^usage," " , $path_inf o f " ",$cookie; 

15 } 

16 print "Content-Type: text/ html\n" ; 

17 print "Pragma: no-cache\nExpires : Mon, 01 Jul 1996 00:00:00 GMT\n " ; 

18 print "\n H ; 

19 if (length($suid) > 0) { 

20 if ( ! ( $ENV{ " HTTP_USER_AGENT" } =~ /3.0/) ) { 

21 open (HTML, "native_CrossSection.html" ) ; 

22 } 

23 else { open (HTML, "nav3_CrossSection.html"); } 



7 



Christian S. Rode (RCI003v2R) Methods and Apparatus for Sharing Computational Resources 



24 read(HTML, my $html, 1000000); 

25 close(HTML); 

26 $html =~ s/<HOST_IP>/$HOST_IP/g; 

2 7 print $html; 

28 } 

29 else { # New cookie 

30 open (DISCLAIMER, "../.. /html / nets im/termsof use . html " ) ; 

31 read (DISCLAIMER, my $disclaimer, 1000000); 

32 close (DISCLAIMER) ; 

33 my $time = sprintf ( "%08x" , time ()) ; 

34 my $mask = substr ( ssumcheck ( $time ) , 0 , 8 ) ; 

35 my $token = &obscure( $time, $mask) . $mask; 

36 $disclaimer =~ s/<! — markerl — >/ \( Please read carefully then 
click <B>ACCEPT<\/B> or <B>DECLINE<\/B> at the bottom of this page\ ) / ; 

37 my $replacement = «"EOF" 

Q 38 <CENTER> 

39 <APPLET CODE="AcceptDecline. Class" CODEBASE="http: / / $HOST_IP/ $PROJECT/ " 

^ WIDTH=250 HEIGHT=40> 

2 40 <PARAM NAME=token VALUE=" $ token "> 

iJl 41 </APPLET> 

|Jj 42 </CENTER> 

43 EOF 

44 ; 

U? 45 $disclaimer =~ s/<l — marker2 — >/$replacement/ ; 

a . 46 print $disclaimer; 

ffl 47 > 

I s * 48 exit(0); 

•"SBS* 

getresults.pl 

ll" 1 #! /usr/bin/perl 

P 

jM= 2 use strict; 

3 require( "getsessionid.pl" ) ; 

4 use vars qw( $debug ); 

5 use vars qw ( $suid $new_suid $user_id $usage $path_info $save_copy 



$cookie) ; 



my 



$results_f ilename = " tmp/results " . $user_id. sprintf ( " %04d" , $usage ) ; 



7 if ( ! (-e $results_f ilename) ) { 

8 open (SAVE, ">$results_f ilename" ) ; 

9 close (SAVE); 

10 require "calculate2.pl"; 

11 > 

12 print "Content-Type: text/html\n" ; 

13 print "Pragma: no-cache\nExpires : Mon, 01 Jul 1996 00:00:00 GMT\n" ; 

14 print "\n" ; 

15 print "<HTML><HEAD>\n" ; 

16 print "<TITLE>Field Extraction Results</TITLE>\n" ; 
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17 print "<SCRIPT LANGUAGE=\ " JavaScript \ ">< I --\n" ; 

18 print " badbrowser = (( navigator . appName == \ "Microsoft Internet 
ExplorerV ) && ( parselnt( navigator . appVersion ) ==4) && 

( navigator. appVer sion. indexOf (V'MacV ) > 0));\n"; 

19 print " if (badbrowser) this . focus (); \n" ; 

20 print " if (I badbrowser && window. focus ) this . focus (); \n " ; 

21 print " //--></SCRIPT>\n" ; 

22 print "<STYLE TYPE=\ "text/ css\ ">\nBODY { font-size : lOpt }\n HI 

{ font-size :24pt }\n H2 { font-size : 20pt }\n H3 { font-size : 16pt 
}\n TABLE { font-size: lOpt }\n TD { font-size : lOpt } \n</STYLE>\n " ; 

23 print ' </HEAD> ' ; 

24 print ' <BODY BGCOLOR="#FFFFFF" TEXT= "#000 000 " LINK="#0000FF" 
VLINK="#AA00AA" ALINK= "#FF0000 "> ' ,"\n"; 

25 my $ results; 

26 open ( STUFF, $results_f ilename ) ; 

27 read(STUFF,$results, 1000000) ; 
2 8 close ( STUFF ) ; 

29 if ($results =- /ERROR/ || length ( $results ) == 0) { 

30 print "<CENTER>\n" ; 

p 31 print "<TABLE><TR><TD WIDTH=\ " 80%\ ">\n " ; 

~ 32 print "<BR><H3>We ' re sorry, but an error occurred attempting to 

^ extract this geometry . <BR> Please check for overlapping elements and try 
V ^ again. </H3>\n" ; 

print "</TD></TR></TABLE>\n" ; 
print "</CENTER>\n" ; 
print ,, </BODY></HTML>\n" ; 
exit 1 ; 

} 

else { 

# POST PROCESS RESULTS INTO HTML (THIS IS A PLACEHOLDER) 
print "<CENTER>\n" ; 
print "<H3>Complete</H3>"; 
print "</CENTER>\n" ; 
print "</BODY></HTML>\n" ; 
exit 0 ; 

} 

sub pretty ( ) { 

my $precision = pop(@_); 
my $number = pop(@_); 
my $index = index $number , "e" , 0 ; 

if ($index < 0) { $index - index $ number , "E " , 0 ; } 
if ($index>0 && $index > $precision) { 

return substr ( $number , 0 , $precision) . substr ( $number ,$ index ) ; 

} 

else { if ($index>0) { return $number; } 

else { return substr ( $number , 0 , $precision ) ; } 

} 

} 

getsessionid.pl 



1 #! /usr/bin/perl 

2 #Copyright (C) 1997-2000 Rode Consulting, Inc. 

3 #A11 rights reserved. 

4 use strict; 



ST! 



33 
34 
35 
36 
37 
38 

39 
40 
41 
42 
43 
44 
45 



46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 



9 



# 



Christian S. Rode (RCI003v2R) Methods and Apparatus for Sharing Computational Resources 

5 use MD5 ; 

6 require ( "project.pl" ) ; 

7 use vars qw( $DOMAIN_NAME $HOST_NAME $HOST_IP $HOST_PREFIX 
$HOST_CGI_PREFIX ) ; 

8 use vars qw( $HOST_PREFIX_JAVA $HOST_CGI_PREFIX_JAVA) ; 

9 use vars qw($BODY $NOCACHE_HEADER $GS $JP2GIF $ ALCHEMY ) ; 

10 use vars qw( %HTML_MACROS ) ; 

11 use vars qw($PROJECT $USAGE_MAX $USAGE_INTERVAL $NUM_RECORDS 
$RECORD_LENGTH) ; 

12 require ( "webdate.pl" ) ; 

13 # GLOBAL S 

14 use vars qw( $debug ); 

15 use vars qw ( $suid $new_suid $user_id $timestamp $usagestamp $usage 
$valid $path_info $cookie); 

16 my $C0OKIE__LENGTH = 35; 

n 

17 #$debug = 1; 
^fl 18 if ($debug) { 

%j 19 print "Content-type: text/html\n\n<HTML><BODY><PRE>\n" ; 

|P9 20 print "path_info: $ENV{ ' PATH_INF0 ' } \ ncookie : $ENV{ ' HTTP_C00KIE ' } \n " ; 

21 } 



H 22 # Any old random number will do (32 bytes)... 

iff 23 my $local_cryptkey = 

C r'baceeed5e3f f 05b8 Ib3 688clel0b9 14bd2al5 18edb6c9 090358eb2 lccef 6da82" ; 

^ 24 sub obscure () { 

Q 25 my $mask = pop @_; 

\A 2 6 my $ target = pop @_; 

•f* 2 7 my $obscured = " " ; 

ijl 28 for (my $i=0; $i<length ( $target ) ; $i++) { 

Q 29 $obscured .= sprintf( "%lx", hex( substr ( $target, $i, 1 ) ) 

l^hex(substr($mask,$i / 1) ) A hex ( substr ( $local_cryptkey , $i , 1 ) ) ); 

5 30 } 

31 return $obscured; 

32 } 

33 sub sumcheck() { 

34 my $ source = pop @_; 

35 # my $sum = 'echo $source | mdSsum 2>/dev/null ' ; 

36 # $sum =- s/\s*-\s*//g; 

37 my $md5 = new MD5 ; 

38 $md5->add($ source. "\n" ) ; 

39 my $sum = unpack( "H32", $md5->digest( ) ); 

40 return $sum; 

41 } 

42 sub encode_suid( ) { 

43 my $usage = pop @_; 
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44 my $usagestamp = pop @_; 

4 5 my $timestamp = pop @_; 

4 6 my $user_id = pop @_; 

47 #open ( LOGFILE , M »logf ile" ) ; 

48 #print LOGFILE "E $user_id $timestamp $usagestamp $usage\n"; 

4 9 #close (LOGFILE ) ; 

50 my $combined = 

$user_id.sprintf ( " %08x%08x%04d" , $timestamp , $usagestamp, $usage ) ; 

51 my $sum = &sumcheck ( $combined) ; 

52 $sum =- s/ A 0*//g? 

53 $sum = substr ( $sum. $sum, 0 , $COOKIE_LENGTH ) ; 

54 my $obscured = &obscure ( $combined, $sum) ; 

55 return $obscured. §sum; 

56 } 

57 sub decode_suid( ) { 

5 8 my $encoded = pop @_; 

o 

"*a 59 my $unobscured = 

;W &obscure ( substr ( $encoded , 0 , $COOKIE_LENGTH ) , substr ( $encoded , $COOKIE_LENGTH , $COOKIE_LE 
h M NGTH) ) ; 



m 



60 my $user_id = substr { $unobscured, 0 , 15 ) ; 

61 my $timestamp = hex substr ( $unobscured, 15 , 8 ) ; 
_ 62 my $usagestamp = hex substr ( $unobscured, 23 , 8 ) ; 

1J1 63 my $usage = hex substr ( $unobscured, 3 1 , 4 ) ; 



HI 
b 



64 #open( LOGFILE, "» log file" ) ; 

65 #print LOGFILE "D $user_id $timestamp $usagestamp $usage\n"; 

66 #close (LOGFILE) ; 



m 6 7 my $ valid = 0; 



68 



if ( $encoded eq &encode_suid ( $user_id, $timestamp, $usagestamp, 



$usage) ) { $valid = 1; } 

69 return ($user_id, $timestamp, $usagestamp, $usage, $valid); 

70 } 

71 # GET USER_ID, USAGE AND PATH_INFO 

7 2 $path_info = $ENV{ ' PATH_INFO ' } ; 

73 $path_info =- s/ [ <> i &\~ ] //g ; 

74 $path_info =~ s/\.{2,}//g; # don't allow uptree accesses 

75 $path_info =- s/\/ {2 , } A //g ; 

7 6 $path_info =-/()/• # Clear $1 

77 $path_info =« s#/ ([ A \/ ]* )/?##; 

7 8 $valid = 0; 

79 $suid = ""; 

80 if ( $ENV{ 'HTTP_COOKIE' } =- /SUID2\s*=\s* ( \w* ) / ) { 

81 $suid = $1; 

82 $suid =~ s/\s*//g; 

83 ($user_id, $timestamp, $usagestamp, $usage, $valid) = 
&decode_suid( $suid) ; 
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84 # Some of the cookies are cached in a database. 

85 # This code is intended to randomly audit the cookie data 

86 # to make sure it isn't corrupt or counterfeited. 

87 sysopen(AUDIT_DB, "auth.dat", 2) or die( "Can't open authorization 
database! " ) ; 

88 my $hash = &hash( $user_id) ; 

89 sysseek( AUDIT_DB, $hash*$RECORD_LENGTH, 0 ); 

90 sysread( AUDIT_DB, my $record, $RECORD_LENGTH- 1 ); # skip newline 

91 (my $prev_user_id, my $prev_time stamp , my $prev_usagestamp, my 
$prev_usage, my $prev_valid) = 

92 &decode_suid( $record) ; 

93 close ( AUDIT_DB ) ; 

94 if ( $prev_valid && ( $prev_user_id eq $user_id) && 

95 ( $prev_usagestamp eq $usagestamp) && ( $usage < $prev_usage) ) { 

96 $valid = 0; # Apparently the cookie is fake 

97 } 

98 # If more than 24 hours (or some other time limit) has passed, 
s«! 99 # reset the usage count 

;~ 100 if ( (time( )-$usagestamp) > $USAGE_INTERVAL ) { 

101 $usagestamp = time(); 

"'%| 102 $usage = -1; 

IH 103 } 

m 

Y! 104 if ($usage > $USAGE_MAX) { 

^ 105 $valid = 0; 

m 106 > 

''"4 ... 

107 # DOS inhibition 

^ 108 if ( 1 ( $ENV{ "HTTP_USER_AGENT" } =~ /Mozilla/ ) ) { 
Qsleep( 15+rand( 10 ) ) ; return 0; } 

y> 109 > 

^ 110 else { # No cookie - create a new one 

111 (my $ip = $ENV{ "REMOTE_ADDR ,f } ) =~ s/\./:/g; 

^ l 112 (my $a, my $b f my $c, my $d) = split ( " : " , $ ip) ; 

Q 113 $ip = (( ($a*256+$b)*256+$c)*256+$d); 

114 my $rand = int ( rand( 2**24 )) ; 

115 $user_id = sprintf ( " Z%08x%06x" , $ip, $rand) ; 



116 $usagestamp = time(); 

117 $usage = -1; 

118 } 

119 $new_suid = &encode_suid ( $user_id, time(), $usagestamp, $usage+l); 

120 # Expire cookie in 90 days 

121 $cookie = "Set-Cookie: SUID2=$new_suid; 

expires=" . &RFC950date ( time ( )+7*24*3600 ) . " ; path=/cgi-bin/$PROJECT/ ; 
domain=$HOST_IP\n" ; 

122 if ($debug) { print "Using PATH_INFO . . . \ n " ; } 

123 if ($debug) { print "SUID: ",$suid," " , "PATH_INFO : " , $path_inf o, " \n" ; } 

124 1; 

host.pl 
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1 #1 /usr/bin/perl 

2 #Copyright (C) 1997-2000 Rode Consulting, Inc. 

3 #A11 rights reserved 

4 use strict; 

5 use vars qw( $DOMAIN_NAME $HOST_NAME $HOST_IP $HOST_PREFIX 
$HOST_CGI_PREFIX) ; 

6 use vars qw( $HOST_PREFIX_JAVA $HOST_CGI_PREFIX__JAVA ) ; 

7 use vars qw($BODY $NOCACHE_HEADER) ; 

8 use vars qw( %HTML_MACROS ) ; 

9 $DOMAIN_NAME= "circuitsim.com" ; 

10 $HOST_NAME = "www. " . $DOMAIN_NAME ; 

11 $HOST_IP = "24.218.251.135"; 

12 my $PREFIX = " Stackup/patent " ; 

13 $HOST_PREFIX = "http : / /$HOST_NAME/$ PREFIX/ " ; 

14 $HOST_CGI_PREFIX = " http : / / $HOST_NAME/ cgi-bin/ $PREFIX / " ; 

15 $HOST_PREFIX_JAVA = " http : / /$HOST_IP/$PREFIX/ " ; 

16 $HOST_CGI_PREFIX_JAVA = " http: / /$HOST_IP/cgi-bin/$PREFIX/ " ; 

^ 17 $BODY = ' <B0DY BGCOLOR="#FFFFFF" TEXT= "#000000 " LINK= "#0 0 0 OFF " 

^ VLINK="#AA00AA" ALINK="#FF0000 "> ' ; 

^ 18 $NOCACHE_HEADER = "Pragma: no-cache\nExpires : Mon, 01 Jul 1996 00:00:00 

H GMT\n"; 

m 

m 19 $HTML_MACROS{ "DOMAIN_NAME" } = ' $DOMAIN_NAME ' ; 

;~ S 20 $HTML_MACROS { "H0ST_NAME " } = ' $HOST_NAME ' ; 

H 21 $HTML_MACROS{"HOST_IP"} = '$HOST_IP f ; 

IJl 22 $HTML_MACROS{"HOST_PREFIX n } = ' $HOST_PREFIX ' ; 

23 $HTML_MACROS{"HOST_CGI_PREFIX"} = ' $HOST_CGI_PREFIX ' ; 

24 $HTML_MACROS{ "HOST_PREFIX_JAVA" } = ' $HOST_PREFIX_JAVA ' ; 

25 $HTML_MACROS{"H0ST_CGI_PREFIX_JAVA"} = ' $HOST_CGI_PREFIX_JAVA ' ; 

26 $HTML_MACROS { " BODY " } = ' $BODY ' ; 

27 $HTML__MACROS{ "TIME " } = ' $TIME ' ; 

28 $HTML_MACROS{ "SESSIONID" } = ' $session_id ' ; 

29 $HTML_MACROS{ "SESSIONIDMACRO" } = ' $session_id_macro ' ; 

30 1; 



3 ? 



in 



makeauth . pi 

1 #1 /usr/bin/perl 

2 require( "project. pi" ) ; 

3 my $nothing = " " ; 

4 for (my $i=0; $i<$RECORD_LENGTH-l ; $i++) { 

5 $nothing .= " " ; 

6 } 

7 open ( AUTH , ">auth . dat " ) ; 

8 for (my $i=0; $i<$NUM_RECORDS; $i++) { 

9 print AUTH $nothing , " \n" ; 
10 } 

project.pl 

1 #! /usr/bin/perl 

2 #Copyright (C) 1997 Rode Consulting, Inc. 

3 #A11 rights reserved. 
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SJ1 

a? 



4 use strict; 

5 use vars qw(§PROJECT $USAGE_MAX $USAGE_INTERVAL $NUM_RECORDS 
$RECORD_LENGTH) ; 

6 $PROJECT = "Stackup" ; 

7 $USAGE_MAX = 10; 

8 $USAGE_ INTERVAL = 12*3600; 

9 $NUM_RECORDS = 10000; 

10 $RECORD_LENGTH =71; 

11 use vars qw( $DOMAIN_NAME $HOST_NAME $HOST_IP $HOST_PREFIX 
$HOST CGI_PREFIX) ; 

12 use vars qw ( $HOST_PREFIX_JAVA $HOST_CGI_PREFIX_JAVA ) ; 

13 use vars qw($BODY $NOCACHE_HEADER $GS $JP2GIF $ ALCHEMY ) ; 

14 use vars qw( %HTML_MACROS ) ; 

15 # Not a general purpose hash - 

16 # intended to use positions 5-11 inclusive of user_id 

17 sub hash( ) { 

18 my $seed = pop @__; 

19 srand( hex substr ( $seed, 5 , 7 ) ); 
2 0 return int ( rand ( $NUM_RECORDS ) ) ; 
21 } 

2 2 require ( " host . pi " ) ; 

23 1; 



t 

H| save.pl 

1 #! /usr/bin/perl 

2 # Copyright 1999-2000 Rode Consulting, Inc. 

3 # All rights reserved 



4 use strict; 

5 require ( "getsessionid.pl" ) ; 

6 use vars qw( $debug ) ; 

7 use vars qw ( $suid $user_id $timestamp $usage $valid $path_info 



$cookie ; 



8 my $cgi_query; 

9 read(STDIN, $cgi_query, $ENV{ ' CONTENT_LENGTH ' } ) ; 

10 print "Content-Type: text/plain\n" ; 

11 print "Pragma: no-cache\nExpires : Mon, 01 Jul 1996 00:00:00 GMT\n"; 

12 print "\n"; 

13 if ( length ($user_id) > 0) { 

14 'rm -f tmp/*$user_id* ' ; 

15 open ( STUFF, ">tmp/stuf f " . $user_id. sprint f ( " %04d" , $usage+l ) ) ; 

16 print STUFF $cgi_query; 

17 close(STUFF) ; 

18 print "0K\n"; 

19 } 

20 else { print " ERR0R\n" ; } 



webdate . pi 
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1 #! /usr/bin/perl 

2 #Copyright (C) 1997 Rode Consulting, Inc. 

3 #A11 rights reserved. 

4 use strict; 

5 # GLOBAL S 

6 use vars qw( $debug ); 

7 sub zeropad2 { 

8 my $number = pop(@_); 

9 my $ padded; 

10 if (?number < 10) { $padded = " 0 " . $number ; } 

11 else { $padded = " " . $number; } 

12 $padded; 

13 } 

14 sub RFC950date { 

15 my $time = pop(@_); 

16 (my $ sec, my $min,my $hour,my $mday,my $mon,my $year,my $wday,my 
□§yday,my $isdat) = gmtime ( $time ) ; 

h g 17 if ($year < 1970) { $year += 1900; } 

^ 18 if ($year < 1970) { $year += 100; } 

IH 19 # $formatted=' /usr/local/bin/date -d ' $time seconds' '+%A, %d-%b-%y 

ijl%T GMT' — universal'; 
u 20 

l-r ( "Sunday", "Monday", "Tuesday ", "Wednesday " , "Thursday" , "Friday "," Saturday " ) [$wday 

". 

" r 4 21 &zeropad2 ( $mday) . "-" . 
22 

q ( "Jan" , "Feb" , "Mar" , "Apr" , "May" , " Jun" , "Jul " , "Aug" , "Sep" , "Oct" , "Nov" , "Dec " ) [ $ mon 

l^ 3 * 23 " $year . " " . 

y 24 &zeropad2 ( $hour ) . ":" . &zeropad2 ( $min ) . ":" . &zeropad2 ( $sec ) . 
aj}" GMT"; 

ij^a 25 } 

l 2 ^ 26 sub modified { 

27 my $file = pop(@_); 

28 (my $dev,my $ino,my $mode,my $nlink,my $uid,my $gid,my $rdev,my 
$size,my $atime,my $mtime,my $ctime,my $blksize,my $blocks) = stat($file); 

29 if ($debug) { print "Modified: ",$mtime," " , time ( ) , " \n" ; print $ A T; 

} 

30 &RFC950date( $mtime) ; 

31 } 

32 1; 

native_CrossSection.html 

1 <HTML> 

2 <HEAD> 

3 <TITLE>EXPERIMENTAL PCB Cross Section Editor</TITLE> 

4 </HEAD> 

5 <BODY BGCOLOR="#FFFFFF" TEXT="#00000 0 " LINK= "#0000FF " VLINK= "#AA00AA" 
ALINK="#FF0000"> 
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6 < APPLET CODE="CrossSection. class" CODEBASE="http: //<HOST_IP>/Stackup/" 
ARCHIVE="CrossSection. jar" WIDTH=1024 HEIGHT=540> 

7 <PARAM NAME=addgeometry VALUE=ENABLE> 

8 <PARAM NAME=userid VALUE=" 00000000 n > 

9 </APPLETXBR><BR> 

10 <! — Instructions deleted — > 

11 </BODY> 

12 </HTML> 
nav3_CrossSection . html 

1 <HTML> 

2 <HEAD> 

3 <TITLE> EXPERIMENTAL PCB Cross Section Editor</TITLE> 

4 </HEAD> 

5 <BODY BGCOLOR= "#FFFFFF " TEXT="#000000 " LINK="#0000FF " VLINK= "#AA00AA" 
ALINK="#FF0000"> 

6 < APPLET CODE="CrossSection. class" CODEBASE="http : / / <HOST_IP>/ Stackup/ " 
ARCHIVE="CrossSection.zip" WIDTH=1024 HEIGHT=540> 

7 <PARAM NAME=addgeometry VALUE=ENABLE> 
m 8 <PARAM NAME=userid VALUE=" 00000000 "> 

9 </APPLETXBR><BR> 

h ~"4 10 <!-- Instructions deleted — > 

m 

m 11 </BODY> 

J"." 12 </HTML> 

P 

Wl . ,/html/Stackup/declined.html 
^ 1 <HTML> 

2 <HEAD><TITLE>Dec 1 ined< / TITLE>< / HEAD> 

^ 3 <BODY BGCOLOR= "#FFFFFF " TEXT= "#00 0000 " LINK= "#OOO0FF " VLINK= "#AA00AA" 

^ ALINK="#FF00OO"> 

y* 

H 4 Sorry you feel that way... 

2 5 </BODY> 

y 6 </HTML> 

. . / . . /html/Stackup/error .html 

1 <HTML> 

2 <HEAD> 

3 <TITLE>Extracting geometry .. .</TITLE> 

4 <SCRIPT LANGUAGE=" JavaScript "><! — 

5 badbrowser = (( navigator . appName == "Microsoft Internet Explorer") 
&& (parselnt (navigator. appVersion) == 4) && ( navigator . appVersion . indexOf ( "Mac " ) > 

0 ) ) ; 

6 if (badbrowser) this . focus () ; 

7 if ('badbrowser && window. focus ) this . focus () ; 

8 //— x/SCRIPT> 

9 </HEAD> 

10 <BODY BGCOLOR= "#FFFFFF " TEXT="#000000 " LINK= "#000 OFF" VLINK= "#AA00AA" 
ALINK="#FF0000"> 

11 <TABLE VALIGN=CENTER WIDTH="100%" HEIGHT= " 100% "XTRXTD VALIGN=CENTER 
ALIGN=CENTER><CENTER> 

12 <H2>We're sorry an ERROR occurred in processing your data.<BR> 

13 Please try again later. </H2> 
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14 <H3><I>Cookies must be enabled!</I></H3> 

15 </CENTERX/TD></TR></TABLE> 

16 </BODY> 

17 </HTML> 

. . / . . /html/Stackup/overuse.html 

1 <HTML> 

2 <HEAD> 

3 <TITLE>Extracting geometry .</TITLE> 

4 <SCRIPT LANGUAGE= " JavaScript " >< ! — 

5 badbrowser = (( navigator . appName == "Microsoft Internet Explorer") 
&& (parselnt( navigator. appVersion) ==4) && ( navigator . appVersion . indexOf ( "Mac" ) > 

0)); 

6 if (badbrowser) this . focus () ; 

7 if ('badbrowser && window. focus ) this . focus () ; 

8 //--X/SCRIPT> 

9 </HEAD> 

10 <BODY BGCOLOR="#FFFFFF" TEXT="#000000 " LINK="#0000FF" VLINK= "#AA00AA" 
ALINK= ,, #FF0000"> 

11 <table valign=center width= " 100% " height=" 100% "><tr><td valign=center 
33align=center><center> 

Q 12 <H2>We're sorry but you've exceeded your<BR>extraction quota for 

^Jtoday . <BR><BR> 

=« 13 Please try again tomorrow . </H2> 

:jj 14 </CENTERX/TD></TRX/TABLE> 

^ 15 </BODY> 

•-ft 16 </HTML> 
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